home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEM / GEMENV.I < prev    next >
Encoding:
Modula Implementation  |  1994-01-11  |  47.5 KB  |  1,777 lines
  1. IMPLEMENTATION MODULE GEMEnv;
  2. (*$Y+*)
  3.  
  4. (*
  5. FROM Terminal IMPORT WriteString, WriteLn, Read; (*  FOR DEBUGGING ONLY  *)
  6. FROM StrConv  IMPORT CardToStr;
  7. *)
  8.  
  9.  
  10. (*      Implementation der Megamax Modula-2 GEM Library (Enviroment)
  11.  *
  12.  *      geschrieben von Manuel Chakravarty
  13.  *
  14.  *      Version 2.2     V#0395      Erstellt März-Oktober 1987
  15.  *)
  16.  
  17.  
  18. (* TT  22.01.88: Parameter in 'GrafHandle' korrekt behandelt
  19.  * TT  22.01.88: SysInit mit Level 0 statt -1
  20.  *     02.06.88: Fehlermeldung bei Benutzung von 'SuspendedProcess'
  21.  *     13.06.88: Optimierung in ASM (bis teilweise 'OpenDevice')
  22.  *     27.06.88: Optimierung in ASM ('OpenDevice')
  23.  *     21.07.88: Jetzt hoffentlich richtige Indexoffsetberechnung in
  24.  *               'OpenDevice'
  25.  *     27.06.89: Benutzt 'ResCtrl'.
  26.  *     02.08.89: 'SuspendedProcess' raus
  27.  *     11.08.89: Verschiebung während dem Kopieren der Geräteparameterliste
  28.  *               korrigiert.
  29.  *     20.08.89: 'GDOSAvailable' + 'GEMVersion' def. + impl. außerdem
  30.  *               Selektorgeschichte auf den 'SelectFileExtended' umgestellt.
  31.  * TT  07.09.89: Kein extended FSel bei GEM V2;
  32.  * TT  ????????: REF-Parm.
  33.  *     01.02.90: 'errorProcPtr' wird im Body gesetzt.
  34.  *     02.04.90: 'GEMAvailable' def. + impl.; Anpassung an public arrays
  35.  * TT  26.06.90: FileSelect raus -> nun im PathEnv-Modul; InitGem init. PathEnv
  36.  *               auch Doku zu InitGem im Def-Text erweitert!
  37.  *               nur der durch InitGem zugewiesene SelectFile schaltet die Maus
  38.  *               selbstst. ein! Bisher wurde das immer von SelectFile hier
  39.  *               erledigt, egal, welche Routine angemeldet war - Mist?!
  40.  * TT  21.11.90: GDOSAvailable drin und getestet; Nur noch ein globales
  41.  *               appl_init und appl_exit pro Prozeß;
  42.  *               Damit ModLoad auch nach Aufruf von "termProc" noch InitGem u.
  43.  *               ExitGem tätigen kann, wird "modId" zu Beginn auf 2 statt 1
  44.  *               gesetzt. So ist "modID"=1 nach "termProc", sodaß die OWNER_ID
  45.  *               bei einem InitGem nicht Null ist (denn dan würde ExitGem nix
  46.  *               freigeben).
  47.  *               'ErrorProc' ist nicht mehr HALT sondern ein neuer TRAP#6-Code;
  48.  *               outOfMemory: LINK A5 statt A6; GEMAvailable angepaßt;
  49.  *               envelopeProc/ExitGem: 'error' wird immer auf FALSE gesetzt,
  50.  *               damit dort nicht noch Fehler gemeldet werden.
  51.  * TT  10.12.90: InitGem/Dev: ShellRead wird nur einmal pro Prozeß gemacht.
  52.  * TT  12.12.90: InitDev: Bei TT-TOS wird auch extended-fileSelector verwendet;
  53.  *               Envelopes: PathEnv.SelectFile wird vom Vater-Prozeß übernommen
  54.  * TT  25.02.91: CloseDevice macht "unloadFonts", wenn nötig.
  55.  * TT  17.04.91: PathEnv.SelectFile wird sowohl bei InitGem als auch bei
  56.  *               InitApplication gesetzt.
  57.  * TT  10.07.93: Kein automatische Error-Meldung mehr bei GemErrors, damit
  58.  *               keine Probleme mehr mit den vielen neuen GEM-Versionen.
  59.  *
  60.  *)
  61.  
  62. FROM    SYSTEM          IMPORT ASSEMBLER, ADDRESS, LONGWORD, WORD,
  63.                                ADR;
  64.  
  65. FROM    Storage         IMPORT SysAlloc, DEALLOCATE;
  66.  
  67. FROM    MOSGlobals      IMPORT MemArea, IllegalPointer, GeneralErr, OutOfMemory,
  68.                                GemErr, FileStr;
  69.  
  70. FROM    PrgCtrl         IMPORT EnvlpCarrier, TermCarrier,
  71.                                Accessory, SetEnvelope, CatchProcessTerm;
  72.  
  73. FROM    ResCtrl         IMPORT RemovalCarrier,
  74.                                CatchRemoval;
  75.  
  76. IMPORT  Directory, FileNames, PathEnv;
  77.  
  78. FROM    GEMGlobals      IMPORT TEffectSet;
  79.  
  80. IMPORT  GEMShare;
  81.  
  82. (* für Tests:
  83.   FROM SysTypes IMPORT ScanDesc;
  84.   FROM SysCtrl IMPORT GetScanAddr;
  85.   FROM GEMScan IMPORT InitChain, InputScan;
  86.   VAR scanidx: CARDINAL; scan: ScanDesc;
  87. *)
  88.  
  89.  
  90. (*$I GEMOPS.ICL *)
  91. (*$I GEMCNF.ICL *)
  92.  
  93.  
  94. CONST   TestVersion     = FALSE; (*  Debugging?  *)
  95.  
  96. (*$? NOT TestVersion: (*$R-*)
  97.  *)
  98.  
  99. TYPE    GemHandle       = p_cb;
  100.  
  101.  
  102. VAR     noInits         : CARDINAL;  (*  Zählt die Anzahl der '(Sys)InitGem's *)
  103.         modID           : INTEGER;   (*  Zählt die Ebenen angemeldeter Module
  104.                                       *  (=0: SysEbene; >0: Mod.init.)
  105.                                       *)
  106.         gemStatus       : (unkown, available);
  107.         
  108.         voidI           : INTEGER;
  109.  
  110.         didShRead: ARRAY [-1..15] OF BOOLEAN; (* 'shellRead' durchgeführt? *)
  111.         appIsInit: ARRAY [-1..15] OF BOOLEAN; (* appIsInit[modID] zeigt an,
  112.                                                * ob schon appl_init() auf-
  113.                                                * gerugen wurde. *)
  114.  
  115.  
  116.                 (*  misc. internal proc.s  *)
  117.                 (*  =====================  *)
  118.  
  119. PROCEDURE outOfMemory;
  120.  
  121.   (*$L-*)
  122.   BEGIN
  123.     ASSEMBLER
  124.         LINK    A5, #0
  125.         TRAP    #noErrorTrap
  126.         DC.W    OutOfMemory - $6000
  127.         UNLK    A5
  128.     END;
  129.   END outOfMemory;
  130.   (*$L=*)
  131.  
  132.  
  133.                         (*  exported proc.s  *)
  134.                         (*  ===============  *)
  135.  
  136. PROCEDURE GrafHandle (VAR charW,
  137.                           charH,
  138.                           cellW,
  139.                           cellH: CARDINAL;
  140.                       VAR hdl  : CARDINAL);
  141.  
  142.   (*$L-*)
  143.   BEGIN
  144.     ASSEMBLER
  145.         MOVE.W      #GRAF_HANDLE,(A3)+
  146.         JSR         aes_if
  147.         MOVE.L      -(A3),A2
  148.         MOVE.L      pubs,A0
  149.         LEA         pubArrays.aINTOUT+$A(A0),A0
  150.         MOVEQ       #$3,D0
  151.     loop
  152.         MOVE.L      -(A3),A1
  153.         MOVE.W      -(A0),(A1)
  154.         DBF         D0,loop
  155.         MOVE.W      -(A0),(A2)      ; !TT 22.01.88
  156.     END;
  157.   END GrafHandle;
  158.   (*$L=*)
  159.  
  160.  
  161. (*$J-*)
  162. PROCEDURE opnwrk0 (    opcode, handle  : CARDINAL;
  163.                        device, koorSys : CARDINAL;
  164.                    VAR param           : ARRAY OF INTEGER): CARDINAL;
  165. (*$J=*)
  166.  
  167.   (*$L-*)
  168.   BEGIN
  169.     ASSEMBLER
  170.         MOVE.W  -(A3),D1
  171.         MOVE.L  -(A3),A1
  172.         MOVE.L  pubs,A0
  173.         MOVE.W  -(A3),pubArrays.vINTIN+20(A0)
  174.         MOVE.W  -(A3),pubArrays.vINTIN(A0)
  175.         CMP.W   #56,D1
  176.         BCC     cont
  177.         
  178.         TRAP    #noErrorTrap
  179.         DC.W    GeneralErr-$2000
  180.         
  181. cont
  182.         LEA     pubArrays.vINTIN+2(A0),A2
  183.         MOVEQ   #8,D0
  184. loop
  185.         MOVE.W  #1,(A2)+
  186.         DBF     D0,loop
  187.         
  188.         MOVE.L  our_cb, A0
  189.         MOVE.W  -(A3),cb.V_CONTRL.handle(A0)
  190.         
  191.         MOVE.L  cb.VDIPB.intout(A0),-(A7)
  192.         MOVE.L  cb.VDIPB.ptsout(A0),-(A7)
  193.         MOVE.L  A1,cb.VDIPB.intout(A0)
  194.         LEA     90(A1),A1
  195.         MOVE.L  A1,cb.VDIPB.ptsout(A0)
  196.         
  197.         MOVE.W  -(A3),D0
  198.         CLR.L   (A3)+
  199.         MOVE.W  D0,(A3)+
  200.         CLR.W   (A3)+
  201.         JSR     vdi_if
  202.         
  203.         MOVE.L  our_cb,A0
  204.         MOVE.L  (A7)+,cb.VDIPB.ptsout(A0)
  205.         MOVE.L  (A7)+,cb.VDIPB.intout(A0)
  206.         MOVE.W  cb.V_CONTRL.handle(A0),(A3)+
  207.     END;
  208.   END opnwrk0;
  209.   (*$L=*)
  210.  
  211. (*$J-*)
  212. PROCEDURE v_opnwk (    device,
  213.                        koorSys: CARDINAL;
  214.                    VAR param  : ARRAY OF INTEGER): CARDINAL;
  215. (*$J=*)
  216.  
  217. (*
  218.  
  219.   VAR     oldpts,oldint           :ADDRESS;
  220.           i                       :CARDINAL;
  221.           
  222.   (*$L+*)
  223.   BEGIN
  224.     IF HIGH(param)<56 THEN        (* Nicht genug Platz für die Parameter *)
  225.       ASSEMBLER
  226.           TRAP    #noErrorTrap
  227.           DC.W    GeneralErr-$2000      ; !TT 22.01.88
  228.       END;
  229.     END;
  230.     our_cb^.V_CONTRL.handle:=0;
  231.     WITH our_cb^ DO
  232.       oldpts:=VDIPB.ptsout;
  233.       oldint:=VDIPB.intout;
  234.       VDIPB.intout:= ADR (param[0]);
  235.       VDIPB.ptsout:= ADR (param[45]);
  236.       vINTIN[0]:=device;
  237.       FOR i:=1 TO 9 DO vINTIN[i]:=1 END;   (* Wird vom GEM ignoriert *)
  238.       vINTIN[10]:=koorSys;
  239.     END;
  240.     vdi_if(NIL,V_OPNWK,0);
  241.     WITH our_cb^ DO
  242.       VDIPB.intout:=oldint;
  243.       VDIPB.ptsout:=oldpts;
  244.       RETURN V_CONTRL.handle
  245.     END;
  246.   END v_opnwk;
  247.   (*$L=*)
  248.  
  249.  *)
  250.  
  251.   (*$L-*)
  252.   BEGIN
  253.     ASSEMBLER
  254.         MOVE.W  -(A3),D0
  255.         MOVE.L  -(A3),D1
  256.         MOVE.L  -(A3),D2
  257.         
  258.         MOVE.W  #V_OPNWK,(A3)+
  259.         CLR.W   (A3)+
  260.         MOVE.L  D2,(A3)+
  261.         MOVE.L  D1,(A3)+
  262.         MOVE.W  D0,(A3)+
  263.         JSR     opnwrk0
  264.     END;
  265.   END v_opnwk;
  266.   (*$L=*)
  267.  
  268. (*$J-*)
  269. PROCEDURE v_opnvwk (    handle          : CARDINAL;
  270.                         device, koorSys : CARDINAL;
  271.                     VAR param           : ARRAY OF INTEGER): CARDINAL;
  272. (*$J=*)
  273.  
  274. (*
  275.  
  276.   VAR     oldpts,oldint           :ADDRESS;
  277.           i                       :CARDINAL;
  278.           
  279.   (*$L+*)
  280.   BEGIN
  281.     IF HIGH(param)<56 THEN        (* Nicht genug Platz für die Parameter *)
  282.       ASSEMBLER
  283.           TRAP    #noErrorTrap
  284.           DC.W    GeneralErr-$2000      ; !TT 22.01.88
  285.       END;
  286.     END;
  287.     our_cb^.V_CONTRL.handle:=handle;
  288.     WITH our_cb^ DO
  289.       oldpts:=VDIPB.ptsout;
  290.       oldint:=VDIPB.intout;
  291.       VDIPB.intout:= ADR (param[0]);
  292.       VDIPB.ptsout:= ADR (param[45]);
  293.       vINTIN[0]:=device;
  294.       FOR i:=1 TO 9 DO vINTIN[i]:=1 END;   (* Wird vom GEM ignoriert *)
  295.       vINTIN[10]:=koorSys;
  296.     END;
  297.     vdi_if(NIL,OPEN_V_WORK,0);
  298.     WITH our_cb^ DO
  299.       VDIPB.intout:=oldint;
  300.       VDIPB.ptsout:=oldpts;
  301.       RETURN V_CONTRL.handle
  302.     END;
  303.   END v_opnvwk;
  304.   (*$L=*)
  305.  
  306.  *)
  307.  
  308.   (*$L-*)
  309.   BEGIN
  310.     ASSEMBLER
  311.         MOVE.L  -(A3),D0
  312.         MOVE.L  -(A3),D1
  313.         MOVE.L  -(A3),D2
  314.         
  315.         MOVE.W  #OPEN_V_WORK,(A3)+
  316.         MOVE.L  D2,(A3)+
  317.         MOVE.L  D1,(A3)+
  318.         MOVE.L  D0,(A3)+
  319.         JSR     opnwrk0
  320.     END;
  321.   END v_opnvwk;
  322.   (*$L=*)
  323.  
  324. PROCEDURE v_clswk (handle: DeviceHandle);
  325.  
  326.   (*$L-*)
  327.   BEGIN
  328.     ASSEMBLER
  329.         MOVE.W  #V_CLSWK,(A3)+
  330.         CLR.W   (A3)+
  331.         JSR     vdi_if
  332.      END;
  333.   END v_clswk;
  334.   (*$L=*)
  335.  
  336. PROCEDURE v_clsvwk (handle: DeviceHandle);
  337.  
  338.   (*$L-*)
  339.   BEGIN
  340.     ASSEMBLER
  341.         MOVE.W  #CLOSE_V_WORK,(A3)+
  342.         CLR.W   (A3)+
  343.         JSR     vdi_if
  344.      END;
  345.   END v_clsvwk;
  346.   (*$L=*)
  347.  
  348.  
  349. TYPE    DeviceHandle    = p_device;
  350.  
  351. PROCEDURE extendedInquire (handle: DeviceHandle; VAR param: ARRAY OF INTEGER);
  352.  
  353. (*
  354.  
  355.   VAR     oldpts,oldint           :ADDRESS;
  356.   
  357.   (*$L+*)
  358.   BEGIN
  359.     IF HIGH(param)<56 THEN        (* Nicht genug Platz für die Parameter *)
  360.       ASSEMBLER
  361.           TRAP    #noErrorTrap
  362.           DC.W    GeneralErr-$2000      ; !TT 22.01.88
  363.       END;
  364.     END;
  365.     WITH our_cb^ DO
  366.       oldpts:=VDIPB.ptsout;
  367.       oldint:=VDIPB.intout;
  368.       VDIPB.intout:= ADR (param[0]);
  369.       VDIPB.ptsout:= ADR (param[45]);
  370.       vINTIN[0]:=1;                     (* Erfrage erweiterte Parameter *)
  371.     END;
  372.     vdi_if(handle,EXTENDED_INQUIRE,0);
  373.     WITH our_cb^ DO
  374.       VDIPB.intout:=oldint;
  375.       VDIPB.ptsout:=oldpts;
  376.     END;
  377.   END extendedInquire;
  378.   (*$L=*)
  379.  
  380.  *)
  381.  
  382.   (*$L-*)
  383.   BEGIN
  384.     ASSEMBLER
  385.         MOVE.W  -(A3),D1
  386.         MOVE.L  -(A3),A1
  387.         MOVE.L  our_cb,A0
  388.         CMP.W   #56,D1
  389.         BCC     cont
  390.         
  391.         TRAP    #noErrorTrap
  392.         DC.W    GeneralErr-$2000
  393.         
  394. cont
  395.         MOVE.L  cb.VDIPB.intout(A0),-(A7)
  396.         MOVE.L  cb.VDIPB.ptsout(A0),-(A7)
  397.         MOVE.L  A1,cb.VDIPB.intout(A0)
  398.         LEA     90(A1),A1
  399.         MOVE.L  A1,cb.VDIPB.ptsout(A0)
  400.         
  401.         MOVE.L  pubs, A0
  402.         MOVE.W  #1,pubArrays.vINTIN(A0)
  403.         
  404.         MOVE.W  #EXTENDED_INQUIRE,(A3)+
  405.         CLR.W   (A3)+
  406.         JSR     vdi_if
  407.         
  408.         MOVE.L  our_cb,A0
  409.         MOVE.L  (A7)+,cb.VDIPB.ptsout(A0)
  410.         MOVE.L  (A7)+,cb.VDIPB.intout(A0)
  411.     END;
  412.   END extendedInquire;
  413.   (*$L=*)
  414.   
  415.  
  416. PROCEDURE OpenDevice (dev, sysKoor, newMode: CARDINAL; VAR hdl: DeviceHandle);
  417.  
  418.   CONST   maxParm         = 56;
  419.   
  420.   VAR     i               : INTEGER;
  421.           current         : p_device;
  422.           parameters      : ARRAY[0..maxParm] OF INTEGER;
  423.           j               : PrivGDPFkt;
  424.           success         : BOOLEAN;
  425.           
  426.   PROCEDURE appendDevice (VAR dev: p_device; VAR success: BOOLEAN);
  427.   
  428.     VAR   i       : logInpDev;
  429.     
  430.     BEGIN
  431.       IF dev = NoDevice THEN
  432.       
  433.         SysAlloc (dev, SIZE (dev^));
  434.         success := (dev # NIL);
  435.         IF success THEN
  436.         
  437.            WITH dev^ DO
  438.              noHdCurs := 0;
  439.              next := NoDevice;
  440.              magic := deviceMagic;
  441.              fontsLoaded:= FALSE;
  442.              FOR i := MIN (logInpDev) TO MAX (logInpDev) DO
  443.                curInpMode[i] := noMode;
  444.              END
  445.            END;
  446.            
  447.         END;
  448.         
  449.       ELSE
  450.         appendDevice (dev^.next, success);
  451.       END;
  452.     END appendDevice;
  453.     
  454.   
  455.   PROCEDURE deleteLast(VAR dev: p_device);
  456.   
  457.     BEGIN
  458.       IF dev^.next # NoDevice THEN dev^.magic := 0; DISPOSE (dev)
  459.       ELSE deleteLast (dev^.next) END;
  460.     END deleteLast;
  461.  
  462.   BEGIN
  463.     WITH our_cb^ DO
  464.     
  465.       appendDevice (DEVICES, success);
  466.       IF NOT success THEN hdl := NoDevice; RETURN END;
  467.       current := DEVICES;
  468.       WHILE current^.next # NoDevice DO current := current^.next END;
  469.       WITH current^ DO
  470.       
  471.         params.charHeight := 0;
  472.         params.charWidth  := 0;
  473.         params.cellHeight := 0;
  474.         params.cellWidth  := 0;
  475.         mode := newMode;
  476.         IF mode = NonVirtual THEN handle := v_opnwk (dev, sysKoor, parameters)
  477.         ELSE handle := v_opnvwk (mode, dev, sysKoor, parameters) END;
  478.         
  479.       END;
  480.       
  481.     END;
  482.     IF current^.handle = 0
  483.     THEN
  484.       deleteLast (our_cb^.DEVICES);
  485.       hdl := NoDevice;
  486.       RETURN
  487.     ELSE
  488.     
  489.       ASSEMBLER
  490.   (*
  491.       our_cb^.CURDEVICE:=current;
  492.       current^.params.rasterWidth:=parameters[0];
  493.       current^.params.rasterHeight:=parameters[1];
  494.       current^.params.pointWidth:=parameters[3];
  495.       current^.params.pointHeight:=parameters[4];
  496.       current^.params.fontSizes:=parameters[5];
  497.       current^.params.lTypes:=parameters[6];
  498.       current^.params.lWidths:=parameters[7];
  499.       current^.params.mTypes:=parameters[8];
  500.       current^.params.mSizes:=parameters[9];
  501.       current^.params.fonts:=parameters[10];
  502.       current^.params.fPatterns:=parameters[11];
  503.       current^.params.fHatchings:=parameters[12];
  504.       current^.params.noColors:=parameters[39];
  505.       current^.params.minWChar:=parameters[45];
  506.       current^.params.minHChar:=parameters[46];
  507.       current^.params.maxWChar:=parameters[47];
  508.       current^.params.maxHChar:=parameters[48];
  509.       current^.params.minWRow:=parameters[49];
  510.       current^.params.maxWRow:=parameters[51];
  511.       current^.params.minWMark:=parameters[53];
  512.       current^.params.minHMark:=parameters[54];
  513.       current^.params.maxWMark:=parameters[55];
  514.       current^.params.maxHMark:=parameters[56];
  515.    *)
  516.         MOVE.L  our_cb,A0
  517.         MOVE.L  current(A6),A1
  518.         MOVE.L  A1,cb.CURDEVICE(A0)
  519.         
  520.         LEA     parameters(A6),A0
  521.         MOVE.W  (A0)+,p_device.params.rasterWidth(A1)
  522.         MOVE.W  (A0)+,p_device.params.rasterHeight(A1)
  523.         LEA     parameters+6(A6),A0
  524.         MOVE.W  (A0)+,p_device.params.pointWidth(A1)
  525.         MOVE.W  (A0)+,p_device.params.pointHeight(A1)
  526.         MOVE.W  (A0)+,p_device.params.fontSizes(A1)
  527.         MOVE.W  (A0)+,p_device.params.lTypes(A1)
  528.         MOVE.W  (A0)+,p_device.params.lWidths(A1)
  529.         MOVE.W  (A0)+,p_device.params.mTypes(A1)
  530.         MOVE.W  (A0)+,p_device.params.mSizes(A1)
  531.         MOVE.W  (A0)+,p_device.params.fonts(A1)
  532.         MOVE.W  (A0)+,p_device.params.fPatterns(A1)
  533.         MOVE.W  (A0)+,p_device.params.fHatchings(A1)
  534.         
  535.         MOVE.W  parameters+78(A6),p_device.params.noColors(A1)
  536.         
  537.         LEA     parameters+90(A6),A0
  538.         MOVE.W  (A0)+,p_device.params.minWChar(A1)
  539.         MOVE.W  (A0)+,p_device.params.minHChar(A1)
  540.         MOVE.W  (A0)+,p_device.params.maxWChar(A1)
  541.         MOVE.W  (A0)+,p_device.params.maxHChar(A1)
  542.         MOVE.W  (A0)+,p_device.params.minWRow(A1)
  543.         
  544.         MOVE.W  parameters+102(A6),p_device.params.maxWRow(A1)
  545.         
  546.         LEA     parameters+106(A6),A0
  547.         MOVE.W  (A0)+,p_device.params.minWMark(A1)
  548.         MOVE.W  (A0)+,p_device.params.minHMark(A1)
  549.         MOVE.W  (A0)+,p_device.params.maxWMark(A1)
  550.         MOVE.W  (A0)+,p_device.params.maxHMark(A1)
  551. (*
  552.       FOR j:=barGDPPriv TO jTextGDPPriv DO
  553.         current^.params.possibleGDPs[j]:=notAvaiblePriv;
  554.       END;
  555.       FOR i:=0 TO parameters[14]-1 DO
  556.         current^.params.possibleGDPs[VAL(PrivGDPFkt,parameters[i+15]-1)]:=
  557.            VAL(PrivGDPAttribute,parameters[i+25]);
  558.       END;
  559.  *)
  560.         MOVE.W  #jTextGDPPriv,D0
  561.         MOVE.W  #notAvaiblePriv,D1
  562.         MOVE.L  current(A6),A0
  563.         LEA     p_device.params.possibleGDPs(A0),A0
  564. loop1
  565.         MOVE.W  D1,(A0)+
  566.         DBF     D0,loop1
  567.         
  568.         MOVE.W  parameters+28(A6),D0
  569.         SUBQ.W  #1,D0
  570.         MOVE.L  current(A6),A0
  571.         LEA     p_device.params.possibleGDPs(A0),A0
  572. loop2
  573.         MOVE.W  D0,D1
  574.         ADD.W   #15,D1
  575.         ADD.W   D1,D1
  576.         MOVE.W  parameters(A6,D1.W),D1
  577.         ADD.W   D1,D1
  578.         MOVE.W  D0,D2
  579.         ADD.W   #25,D2
  580.         ADD.W   D2,D2
  581.         MOVE.W  parameters(A6,D2.W),-2(A0,D1.W)
  582.         DBF     D0,loop2
  583.     
  584. (*
  585.       current^.params.color:=(parameters[35]=1);
  586.       current^.params.fill:=(parameters[37]=1);
  587.       current^.params.cArray:=(parameters[38]=1);
  588.       current^.params.grafCCtrl:=VAL(PrivInputDev,parameters[40]-1);
  589.       current^.params.valueIn:=VAL(PrivInputDev,parameters[41]-1);
  590.       current^.params.caseIn:=VAL(PrivInputDev,parameters[42]-1);
  591.       current^.params.alphanumIn:=VAL(PrivInputDev,parameters[43]-1);
  592.       current^.params.deviceType:=VAL(PrivDeviceType,parameters[44]);
  593.  *)
  594.         MOVE.L  current(A6),A1
  595.         MOVE.W  parameters+70(A6),p_device.params.color(A1)
  596.         MOVE.W  parameters+74(A6),p_device.params.fill(A1)
  597.         MOVE.W  parameters+76(A6),p_device.params.cArray(A1)
  598.         
  599.         LEA     parameters+80(A6),A0
  600.         MOVE.W  (A0)+,D0
  601.         SUBQ.W  #1,D0
  602.         MOVE.L  D0,p_device.params.grafCCtrl(A1)
  603.         MOVE.W  (A0)+,D0
  604.         SUBQ.W  #1,D0
  605.         MOVE.L  D0,p_device.params.valueIn(A1)
  606.         MOVE.W  (A0)+,D0
  607.         SUBQ.W  #1,D0
  608.         MOVE.L  D0,p_device.params.caseIn(A1)
  609.         MOVE.W  (A0)+,D0
  610.         SUBQ.W  #1,D0
  611.         MOVE.L  D0,p_device.params.alphanumIn(A1)
  612.         MOVE.W  (A0)+,p_device.params.deviceType(A1)
  613. (*
  614.       extendedInquire(current,parameters);  (* erweiterte Parameter *)
  615.       current^.params.screen:=VAL(PrivScreenType,parameters[0]);
  616.       current^.params.bgColors:=parameters[1];
  617.       current^.params.useTEffects:=TEffectSet(SHORT(WORD(parameters[2])));
  618.       current^.params.zooming:=(parameters[3]=1);
  619.       current^.params.maxRasterPls:=parameters[4];
  620.       current^.params.lookUpTab:=(parameters[5]=0);
  621.       current^.params.op16PerSec:=parameters[6];
  622.       current^.params.contFill:=(parameters[7]=1);
  623.       current^.params.textRot:=VAL(PrivTextRotType,parameters[8]);
  624.       current^.params.noWrtModes:=parameters[9];
  625.       current^.params.maxInMode:=parameters[10];
  626.       current^.params.textJust:=(parameters[11]=1);
  627.       current^.params.penChange:=(parameters[12]=0);
  628.       current^.params.colorRibbon:=(parameters[13]=0);
  629.       current^.params.maxMarker:=parameters[14];
  630.       IF intinMax <= parameters[15] THEN
  631.         current^.params.maxStrLen:=intinMax (* Unser Array ist eben nicht größer*)
  632.       ELSE
  633.         current^.params.maxStrLen:=parameters[15]
  634.       END;
  635.       current^.params.noMButts:=parameters[16];
  636.       current^.params.thickLnTyps:=(parameters[17]=1);
  637.       current^.params.thickLnModes:=parameters[18];
  638.    *)
  639.         MOVE.L  current(A6),(A3)+
  640.         LEA     parameters(A6),A0
  641.         MOVE.L  A0,(A3)+
  642.         MOVE.W  #maxParm,(A3)+
  643.         JSR     extendedInquire
  644.         
  645.         LEA     parameters(A6),A0       ; 'ADR (parameters)' -> A0
  646.         MOVE.L  current(A6),A1          ; 'current' -> A1
  647.         
  648.         MOVE.W  (A0)+,p_device.params.screen(A1)
  649.         MOVE.W  (A0)+,p_device.params.bgColors(A1)
  650.         MOVE.W  (A0)+,D0
  651.         MOVE.B  D0,p_device.params.useTEffects(A1)
  652.         MOVE.W  (A0)+,p_device.params.zooming(A1)
  653.         MOVE.W  (A0)+,p_device.params.maxRasterPls(A1)
  654.         MOVE.W  (A0)+,p_device.params.lookUpTab(A1)
  655.         MOVE.W  (A0)+,p_device.params.op16PerSec(A1)
  656.         MOVE.W  (A0)+,p_device.params.contFill(A1)
  657.         MOVE.W  (A0)+,p_device.params.textRot(A1)
  658.         MOVE.W  (A0)+,p_device.params.noWrtModes(A1)
  659.         MOVE.W  (A0)+,p_device.params.maxInMode(A1)
  660.         MOVE.W  (A0)+,p_device.params.textJust(A1)
  661.         TST.W   (A0)+
  662.         SEQ     D0
  663.         AND.W   #1,D0
  664.         MOVE.W  D0,p_device.params.penChange(A1)
  665.         TST.W   (A0)+
  666.         SEQ     D0
  667.         AND.W   #1,D0
  668.         MOVE.W  D0,p_device.params.colorRibbon(A1)
  669.         MOVE.W  (A0)+,p_device.params.maxMarker(A1)
  670.         
  671.         MOVE.W  (A0)+,D0
  672.         CMP.W   #intinMax,D0
  673.         BCS     else1
  674.         MOVE.W  #intinMax,p_device.params.maxStrLen(A1)
  675.         BRA     endif1
  676. else1
  677.         MOVE.W  D0,p_device.params.maxStrLen(A1)
  678. endif1
  679.  
  680.         MOVE.W  (A0)+,p_device.params.noMButts(A1)
  681.         MOVE.W  (A0)+,p_device.params.thickLnTyps(A1)
  682.         MOVE.W  (A0)+,p_device.params.thickLnModes(A1)
  683.       END;
  684.       
  685.     END;
  686.     hdl := current;
  687.     
  688.   END OpenDevice;
  689.  
  690. PROCEDURE CloseDevice (handle: DeviceHandle);
  691.  
  692.   VAR   current: p_device;
  693.         success: BOOLEAN;
  694.         
  695.   PROCEDURE deleteDevice (VAR dev: p_device; toDelete: p_device);
  696.   
  697.     BEGIN
  698.       IF dev = toDelete THEN
  699.         dev := toDelete^.next;
  700.         DISPOSE (toDelete);
  701.       ELSE deleteDevice (dev^.next, toDelete) END
  702.     END deleteDevice;
  703.  
  704.   BEGIN
  705.     setDevice (handle, success);
  706.     IF success THEN
  707.       current := our_cb^.CURDEVICE;
  708.       IF current^.fontsLoaded THEN
  709.         unloadFonts (current, 0)
  710.       END;
  711.       IF current^.mode = NonVirtual THEN v_clswk (current)
  712.       ELSE v_clsvwk (current) END;
  713.       current^.magic := 0;
  714.       deleteDevice (our_cb^.DEVICES, current);
  715.     END;
  716.   END CloseDevice;
  717.  
  718. PROCEDURE DeviceParameter (handle: DeviceHandle): PtrDevParm;
  719.  
  720.   VAR     success : BOOLEAN;
  721.   
  722.   BEGIN
  723.     setDevice (handle, success);
  724.     IF success THEN RETURN ADR (our_cb^.CURDEVICE^.params)
  725.     ELSE RETURN NIL END;
  726.   END DeviceParameter;
  727.  
  728.  
  729. PROCEDURE GemActive (): BOOLEAN;
  730.  
  731.   (*$L-*)
  732.   BEGIN
  733.     ASSEMBLER
  734.         CLR.W   D0              ; noInits=0 => FALSE
  735.         TST.W   noInits
  736.         SEQ     D0
  737.         ADDQ.B  #1,D0
  738.         MOVE.W  D0,(A3)+
  739.     END;
  740.   END GemActive;
  741.   (*$L=*)
  742.  
  743. PROCEDURE GemError (): BOOLEAN;
  744.  
  745.   (*$L-*)
  746.   BEGIN
  747.     ASSEMBLER
  748.         MOVE.W      error,(A3)+
  749.         CLR.W       error
  750.     END;
  751.   END GemError;
  752.   (*$L=*)
  753.  
  754. PROCEDURE ErrorNumber (): INTEGER;
  755.  
  756.   (*$L-*)
  757.   BEGIN
  758.     ASSEMBLER
  759.         MOVE.W  errNum,(A3)+
  760.     END;
  761.   END ErrorNumber;
  762.   (*$L=*)
  763.  
  764.  
  765. FORWARD selectFileTOSDependent (REF label     : ARRAY OF CHAR;
  766.                                 VAR path, name: ARRAY OF CHAR;
  767.                                 VAR ok        : BOOLEAN);
  768.  
  769.  
  770. PROCEDURE initGem (VAR success: BOOLEAN;
  771.                        sys    : BOOLEAN);
  772.   
  773.   VAR   oldc                            : p_cb;
  774.         virgin                          : BOOLEAN;      (*  Erster cb?  *)
  775.   
  776.   BEGIN
  777.     
  778.     success := FALSE;
  779.     virgin := (root_cb = NIL);
  780.     
  781.     oldc := our_cb;                 (* Alte private Var's merken *)
  782.     SysAlloc (our_cb, SIZE (our_cb^));
  783.     IF our_cb = NIL                 (* Speicher voll => Abbruch *) THEN
  784.       outOfMemory;
  785.       our_cb := oldc;
  786.       RETURN
  787.     END;
  788.     
  789.     (*  Falls nötig fordere die public arrays an.
  790.      *)
  791.     IF virgin THEN
  792.     
  793.       SysAlloc (pubs, SIZE (pubs^));
  794.       IF pubs = NIL THEN
  795.         outOfMemory;
  796.         DEALLOCATE (our_cb, SIZE (our_cb^));
  797.         our_cb := oldc;
  798.         RETURN
  799.       END;
  800.       
  801.     END;
  802.     
  803.     (*  Init neue private Vars *)
  804.     
  805.     WITH our_cb^ DO
  806.     
  807.       LASTCB := root_cb;     (*  Neuer 'cb' ist erster in der Liste  *)
  808.       
  809.      (*  Supervision-Parameter initialisieren
  810.       *)
  811.       WITH SUPERVISION DO
  812.         noGrafMouse := 0;
  813.         noUpWind := 0;
  814.         noMouseCtrl := 0;
  815.         openWinds := LONGWORD (0L);
  816.         createWinds := LONGWORD (0L);
  817.         timerChgd := FALSE;
  818.         butChgChgd := FALSE;
  819.         msMoveChgd := FALSE;
  820.         curChgChgd := FALSE;
  821.       END;
  822.       
  823.       A_CONTRL.saddrout := 0;
  824.       
  825.       (*  AES-/VDI-Paramterblöcke mit Array-Adresse init.
  826.        *)
  827.       AESPB.contrl  := ADR (A_CONTRL);
  828.       AESPB.global  := ADR (GLOBAL);
  829.       AESPB.intin   := ADR (pubs^.aINTIN);
  830.       AESPB.intout  := ADR (pubs^.aINTOUT);
  831.       AESPB.addrin  := ADR (pubs^.ADDRIN);
  832.       AESPB.addrout := ADR (pubs^.ADDROUT);
  833.       VDIPB.contrl  := ADR (V_CONTRL);
  834.       VDIPB.ptsin   := ADR (pubs^.PTSIN);
  835.       VDIPB.ptsout  := ADR (pubs^.PTSOUT);
  836.       VDIPB.intin   := ADR (pubs^.vINTIN);
  837.       VDIPB.intout  := ADR (pubs^.vINTOUT);
  838.       
  839.       (*  Anmeldung beim AES
  840.        *)
  841.       IF NOT appIsInit[modID] THEN
  842.         GLOBAL.ap_version:= 0;
  843.         aes_if (APPL_INIT);
  844.         GLOBAL.ap_id := pubs^.aINTOUT[0];
  845.         IF GLOBAL.ap_version # 0 THEN gemStatus := available END;
  846.         IF (gemStatus # available) OR (GLOBAL.ap_id < 0)  (*  AES o.k.?  *) THEN
  847.           IF virgin THEN DEALLOCATE (pubs, SIZE (pubs^)) END;
  848.           DEALLOCATE (our_cb, SIZE (our_cb^));
  849.           our_cb := oldc;
  850.           RETURN
  851.         END;
  852.         PathEnv.SelectFile:= selectFileTOSDependent;
  853.         DIDAPPLINIT:= TRUE;
  854.         appIsInit[modID]:= TRUE;
  855.         error:= FALSE;
  856.       ELSE
  857.         DIDAPPLINIT:= FALSE;
  858.         GLOBAL:= root_cb^.GLOBAL
  859.       END;
  860.       
  861.       (*  Geräteliste := leere Liste
  862.        *)
  863.       DEVICES := NoDevice;
  864.       CURDEVICE:=NoDevice;
  865.  
  866.     END;(*WITH*)
  867.     
  868.     (*
  869.       GetScanAddr (scan); InitChain (scan);
  870.       scanidx:= 1; InputScan ('InitGem', scanidx);
  871.     *)
  872.     
  873.     (*
  874.       saveSelector;                 (* Aktuelle File-Selektor-Box retten *)
  875.     *)
  876.     
  877.     IF sys THEN
  878.       our_cb^.OWNER_ID := -modID;   (* Merke ID des anmeldenden Moduls *)
  879.     ELSE
  880.       our_cb^.OWNER_ID := modID;    (* Merke ID des anmeldenden Moduls *)
  881.     END;
  882.     root_cb := our_cb;            (*  Neuer cb bildet Listenanfang
  883.                                    *  Listenordnung: historisch
  884.                                    *)
  885.     our_cb^.MAGIC := cbMagic;
  886.     INC (noInits);                (* Anzahl der Level-Init's erhöhen *)
  887.     
  888.     success := TRUE;              (* Neuer Level erfolgreich angemeldet! *)
  889.   END initGem;
  890.  
  891. PROCEDURE InitApplication (VAR success: BOOLEAN);
  892.   (*$L-*)
  893.   BEGIN
  894.     ASSEMBLER
  895.         CLR.W   (A3)+
  896.         JMP     initGem
  897.     END
  898.   END InitApplication;
  899.   (*$L=*)
  900.  
  901. PROCEDURE SysInitApplication (VAR success: BOOLEAN);
  902.   (*$L-*)
  903.   BEGIN
  904.     ASSEMBLER
  905.         MOVE    #TRUE,(A3)+
  906.         JMP     initGem
  907.     END
  908.   END SysInitApplication;
  909.   (*$L=*)
  910.  
  911. PROCEDURE ExitApplication;
  912.   (*$L-*)
  913.   BEGIN
  914.     ASSEMBLER
  915.         MOVE.L  our_cb,-(A7)
  916.         MOVE.L  A7,(A3)+        ; VAR-Parameter!
  917.         JSR     ExitGem         ; ExitGem (CurrGemHandle())
  918.         ADDQ.L  #4,A7
  919.     END
  920.   END ExitApplication;
  921.   (*$L=*)
  922.  
  923.  
  924. PROCEDURE initDev (    sysKoor: CARDINAL;
  925.                    VAR handle : DeviceHandle;
  926.                    VAR success: BOOLEAN;
  927.                        sys    : BOOLEAN);
  928.  
  929.   CONST   screen  = 1;     (*  device = Bildschirm  *)
  930.  
  931.   VAR   oldc                            : p_cb;
  932.         wrkStation                      : CARDINAL;
  933.         charH, charW, cellW, cellH      : CARDINAL;
  934.         virgin                          : BOOLEAN;      (*  Erster cb?  *)
  935.         args                            : ARRAY[0..127] OF CHAR;
  936.         name                            : FileStr;
  937.   
  938.   BEGIN
  939.     virgin := (root_cb = NIL);
  940.     oldc := our_cb;                 (* Alte private Vars merken *)
  941.     initGem (success, sys);
  942.     IF success THEN
  943.       WITH our_cb^ DO
  944.         
  945.         (* Standardgerät (Screen) anmelden *)
  946.         GrafHandle (charH, charW, cellH, cellW, wrkStation);
  947.         OpenDevice (screen, sysKoor, wrkStation, handle);
  948.         IF handle = NoDevice THEN
  949.           IF virgin THEN DEALLOCATE (pubs, SIZE (pubs^)) END;
  950.           DEALLOCATE (our_cb, SIZE (our_cb^));
  951.           our_cb := oldc;
  952.           success := FALSE;
  953.           RETURN
  954.         END;
  955.           
  956.         WITH DEVICES^.params DO
  957.           charHeight:=charH;
  958.           charWidth:=charW;
  959.           cellHeight:=cellH;
  960.           cellWidth:=cellH;
  961.         END;
  962.         CURDEVICE:=DEVICES;
  963.         
  964.       END;(*WITH*)
  965.  
  966.       (* PathEnv-Vars / File-Selektor-Box init. *)
  967.       IF NOT didShRead[modID] THEN
  968.         (* nur beim 1. Mal, da später evtl. durch rsrc_load bei alten TOS-
  969.          * Versionen der Shell-Puffer überschrieben wird! *)
  970.         shellRead (name, args);
  971.         FileNames.SplitPath (name, PathEnv.HomePath, name);
  972.         IF PathEnv.HomePath [0] = 0C THEN
  973.           Directory.GetDefaultPath (PathEnv.HomePath)
  974.         END;
  975.         didShRead[modID]:= TRUE
  976.       END;
  977.     END;
  978.   END initDev;
  979.  
  980. PROCEDURE InitGem (    sysKoor: CARDINAL;
  981.                    VAR handle : DeviceHandle;
  982.                    VAR success: BOOLEAN);
  983.   (*$L-*)
  984.   BEGIN
  985.   (*$? TestVersion:
  986.     WriteString ("--'GemEnv.InitGem' invoked'--");
  987.    *)
  988.     ASSEMBLER
  989.         CLR     (A3)+
  990.         JMP     initDev
  991.     END;
  992.   END InitGem;
  993.   (*$L=*)
  994.  
  995. PROCEDURE SysInitGem (    sysKoor: CARDINAL;
  996.                       VAR handle : DeviceHandle;
  997.                       VAR success: BOOLEAN);
  998.   (*$L-*)
  999.   BEGIN
  1000.   (*$? TestVersion:
  1001.     WriteString ("--'GemEnv.SysInitGem' invoked'--");
  1002.    *)
  1003.     ASSEMBLER
  1004.         MOVE    #TRUE,(A3)+
  1005.         JMP     initDev
  1006.     END;
  1007.   END SysInitGem;
  1008.   (*$L=*)
  1009.  
  1010. PROCEDURE closeDelWinds;
  1011.  
  1012.   (*$L-*)
  1013.   BEGIN
  1014.     (*$? doSupervision:
  1015.     ASSEMBLER
  1016.                                 ; Schließe Fenster
  1017.         MOVE.L  our_cb,A0
  1018.         CLR.W   D0              ; Beginne bei Handle #0
  1019.         MOVE.L  cb.SUPERVISION.openWinds(A0),D1
  1020. loop1
  1021.         BCLR    D0,D1           ; Lösche Handle-Bit
  1022.         BEQ     cont1           ; Springe, falls Handle nicht eingetrag.
  1023.         MOVE.W  D0,(A3)+
  1024.         MOVEM.L D0/D1/A0,-(A7)
  1025.         JSR     closeWindow     ; closeWindow(D0)
  1026.         MOVEM.L (A7)+,D0/D1/A0
  1027. cont1
  1028.         ADDQ.W  #1,D0           ; nächstes Handle
  1029.         TST.L   D1
  1030.         BNE     loop1           ; nochmal, falls ein Handle übrig
  1031.         
  1032.                                 ; Lösche Fenster
  1033.         CLR.W   D0              ; Beginne bei Handle #0
  1034.         MOVE.L  cb.SUPERVISION.createWinds(A0),D1
  1035. loop2
  1036.         BCLR    D0,D1           ; Lösche Handle-Bit
  1037.         BEQ     cont2           ; Springe, falls Handle nicht eingetrag.
  1038.         MOVE.W  D0,(A3)+
  1039.         MOVEM.L D0/D1/A0,-(A7)
  1040.         JSR     deleteWindow    ; deleteWindow(D0)
  1041.         MOVEM.L (A7)+,D0/D1/A0
  1042. cont2
  1043.         ADDQ.W  #1,D0           ; nächstes Handle
  1044.         TST.L   D1
  1045.         BNE     loop2           ; nochmal, falls ein Handle übrig
  1046.     END;
  1047.     *)
  1048.   END closeDelWinds;
  1049.   (*$L=*)
  1050.  
  1051. (*$J-*)
  1052. PROCEDURE isValidGemHandle (handle: GemHandle): BOOLEAN;
  1053. (*$J=*)
  1054.  
  1055.   (*$L-*)
  1056.   BEGIN
  1057.     ASSEMBLER
  1058.         MOVE.L  -(A3),D0        ; 'handle' -> D0
  1059.         ANDI.W  #-2,D0          ; nur gerade Addr. zulassen
  1060.         MOVE.L  D0,A0           ; 'handle' -> A0
  1061.         
  1062.         CMPA.L  #NIL,A0
  1063.         BNE     notNIL          ; jump, if curr. 'handle # NIL'
  1064.         MOVE.W  #FALSE,(A3)+    ; ERROR!
  1065.         BRA     ende
  1066.         
  1067. notNIL
  1068.         MOVE.W  cb.MAGIC(A0),D0
  1069.         CMP.W   #cbMagic,D0
  1070.         BEQ     validHandle     ; jump, if magic is valid
  1071.         TRAP    #noErrorTrap
  1072.         DC.W    IllegalPointer - $4000
  1073.         MOVE.W  #FALSE,(A3)+
  1074.         BRA     ende
  1075.         
  1076. validHandle
  1077.         MOVE.W  #TRUE,(A3)+
  1078. ende
  1079.     END;
  1080.   END isValidGemHandle;
  1081.   (*$L=*)
  1082.  
  1083.  
  1084. (*  mouseInput0 -- Ist 'start = TRUE', so werden alle mouse-hides des
  1085.  *                 aktuellen 'cb' rückgänig gemacht. Ist 'start = FALSE'
  1086.  *                 werden die mouse hides wieder durchgeführt. Also
  1087.  *                 der alte Status wiederhergestellt.
  1088.  *)
  1089.  
  1090. PROCEDURE mouseInput0 (start:BOOLEAN);
  1091.  
  1092.   CONST   mouseOff        = 9;    (* Ordinalzahl des Modula-Aufzählungs- *)
  1093.           mouseOn         = 10;   (* typen 'MouseForm'                   *)
  1094.   
  1095.   (*$L-*)
  1096.   BEGIN
  1097.     ASSEMBLER
  1098.         MOVEM.L D4/D5/A4,-(A7)
  1099.         
  1100.         MOVE.W  -(A3),D4
  1101.         
  1102.         (*$? doSupervision:
  1103.         
  1104.         ;                       'GrafMouse' bearbeiten
  1105.         MOVE.L  our_cb,A0
  1106.         TST.W   D4
  1107.         BEQ     hideIt1
  1108.         MOVE.W  cb.SUPERVISION.noGrafMouse(A0),D5
  1109.         MOVE.W  D5,cb.SUPERVISION.oldGrafMouse(A0)
  1110.         BRA     loop1Start
  1111. hideIt1
  1112.         MOVE.W  cb.SUPERVISION.oldGrafMouse(A0),D5
  1113.         BRA     loop1Start
  1114. loop1
  1115.         MOVE.W  #mouseOff,D2
  1116.         TST.W   D4
  1117.         BEQ     hideIt2
  1118.         MOVE.W  #mouseOn,D2
  1119. hideIt2
  1120.         MOVE.W  D2,(A3)+
  1121.         CLR.L   (A3)+
  1122.         JSR     grafMouse
  1123. loop1Start
  1124.         DBF     D5,loop1
  1125.         
  1126.         ;                       'Hide-/ShowCursor' bearbeiten
  1127.         MOVE.L  our_cb,A0
  1128.         MOVE.L  cb.DEVICES(A0),A4
  1129.         BRA     loop3Start
  1130.         
  1131. loop3
  1132.         TST.W   D4
  1133.         BEQ     hideIt3
  1134.         MOVE.W  device.noHdCurs(A4),D5
  1135.         MOVE.W  D5,device.oldHdCurs(A4)
  1136.         BRA     loop2Start
  1137. hideIt3
  1138.         MOVE.W  device.oldHdCurs(A4),D5
  1139.         BRA     loop2Start
  1140. loop2
  1141.         MOVE.L  A4,(A3)+
  1142.         TST.W   D4
  1143.         BEQ     hideIt4
  1144.         MOVE    #FALSE,(A3)+
  1145.         JSR     showCursor
  1146.         BRA     c1
  1147. hideIt4
  1148.         JSR     hideCursor
  1149. c1
  1150. loop2Start
  1151.         DBF     D5,loop2
  1152.         MOVE.L  device.next(A4),A4
  1153. loop3Start
  1154.         MOVE.L  A4,D0
  1155.         BNE     loop3
  1156.         
  1157.         *)
  1158.         
  1159.         MOVEM.L (A7)+,D4/D5/A4
  1160.     END;
  1161.   END mouseInput0;
  1162.   (*$L=*)
  1163.  
  1164. (*  mouseInput -- Wie 'mouseInput0', nur für alle mouse hides, die von
  1165.  *                dieser GEM-Bibliothek durchgeführt wurden (alle 'cb's)
  1166.  *)
  1167.  
  1168. PROCEDURE mouseInput (start:BOOLEAN);
  1169.  
  1170.   VAR     oldHdl  : GemHandle;
  1171.   
  1172.   BEGIN
  1173.     (*$? doSupervision:
  1174.     ASSEMBLER
  1175.         MOVE.L  A4,-(A7)
  1176.         JSR     CurrGemHandle
  1177.         MOVE.L  -(A3),oldHdl(A6)
  1178.         
  1179.         MOVE.L  root_cb,A4
  1180.         BRA     loopStart
  1181. loop
  1182.         MOVE.L  A4,(A3)+
  1183.         SUBQ.L  #2,A7
  1184.         MOVE.L  A7,(A3)+
  1185.         JSR     SetCurrGemHandle
  1186.         TST.W   (A7)+
  1187.         BEQ     errHdl
  1188.         MOVE.W  start(A6),(A3)+
  1189.         JSR     mouseInput0
  1190. errHdl
  1191.         MOVE.L  cb.LASTCB(A4),A4
  1192. loopStart
  1193.         MOVE.L  A4,D0
  1194.         BNE     loop
  1195.         
  1196.         MOVE.L  oldHdl(A6),(A3)+
  1197.         SUBQ.L  #2,A7
  1198.         MOVE.L  A7,(A3)+
  1199.         JSR     SetCurrGemHandle
  1200.         TST.W   (A7)+
  1201.         MOVE.L  (A7)+,A4
  1202.     END;
  1203.     *)
  1204.   END mouseInput;
  1205.  
  1206. PROCEDURE exitGem (VAR handle: GemHandle; remove: BOOLEAN);
  1207.  
  1208.   PROCEDURE whipFromList (VAR list: p_cb; elem: p_cb);
  1209.   
  1210.     BEGIN
  1211.       IF list = elem THEN list := elem^.LASTCB
  1212.       ELSE whipFromList (list^.LASTCB, elem) END;
  1213.     END whipFromList;
  1214.  
  1215.  
  1216.   VAR   oldc    : p_cb;
  1217.         current : p_device;
  1218.         i       : CARDINAL;
  1219.   
  1220.   BEGIN
  1221. (*$? TestVersion:
  1222.   WriteString ("'ExitGem' invoked...");
  1223.  *)
  1224.     (*
  1225.       GetScanAddr (scan); InitChain (scan);
  1226.       scanidx:= 1; InputScan ('ExitGem', scanidx);
  1227.     *)
  1228.     
  1229.     IF isValidGemHandle (handle) THEN
  1230.     
  1231.       our_cb := handle;
  1232.       
  1233.       IF our_cb^.OWNER_ID # 0 THEN
  1234.       
  1235.       (*
  1236.         RemoveSelector;     (* Alte File-Selektor-Box wieder einhängen *)
  1237.        *)
  1238.         mouseInput (TRUE);  (* Alten Mausstatus wiederherstellen *)
  1239.  
  1240.                               (* VDI zurücksetzen *)
  1241.  
  1242. (*
  1243. $? TestVersion:
  1244.   WriteString ("reset VDI...");
  1245.  *)
  1246.          (*  'showCursor'-Aufrufe sind schon ausgeführt worden
  1247.           *)
  1248.          (*$? doSupervision:
  1249.          WITH our_cb^.SUPERVISION DO    (* Melde alle GEM-IR-Vektoren ab *)
  1250.            WHILE timerChgd DO
  1251.              removeTimerVector (timerVecList^)
  1252.            END;
  1253.            WHILE butChgChgd DO
  1254.              removeButChgVector (butChgVecList^)
  1255.            END;
  1256.            WHILE msMoveChgd DO
  1257.              removeMsMoveVector (msMoveVecList^)
  1258.            END;
  1259.            WHILE curChgChgd DO
  1260.              removeCurChgVector (curChgVecList^)
  1261.            END;
  1262.          END;(*WITH*)
  1263.          *)
  1264.  
  1265.                         (* Devices abmelden *)
  1266.  
  1267. (*
  1268. $? TestVersion:
  1269.   WriteString ("deinstall devices...");
  1270.  *)
  1271.         WHILE our_cb^.DEVICES # NIL DO
  1272.           CloseDevice (our_cb^.DEVICES);
  1273.         END;
  1274.  
  1275.                       (* AES zurücksetzen und eventuell Obj. abmelden *)
  1276.  
  1277. (*
  1278. $? TestVersion:
  1279.   WriteString ("reset AES...");
  1280.  *)
  1281.         (*$? doSupervision:
  1282.         WITH our_cb^.SUPERVISION DO
  1283.           FOR i := 1 TO noUpWind DO updateWindow (FALSE) END;
  1284.           FOR i := 1 TO noMouseCtrl DO updateWindow (ORD (FALSE) + 2) END;
  1285.           closeDelWinds; (* Schließe und lösche alle Fenster dieser Modulebene*)
  1286.         END;
  1287.         *)
  1288.         
  1289.         IF our_cb^.DIDAPPLINIT THEN
  1290.           aes_if (APPL_EXIT);
  1291.           our_cb^.DIDAPPLINIT:= FALSE;
  1292.           appIsInit[modID]:= FALSE;
  1293.           error:= FALSE
  1294.         END
  1295.       END;(*IF OWNER_ID # 0*)
  1296.  
  1297.                   (* Kette our_cb aus der cb-Liste aus *)
  1298.  
  1299. (*
  1300. $? TestVersion:
  1301.   WriteString ("delist 'cb'...");
  1302.  *)
  1303.       IF remove THEN
  1304.       
  1305.         oldc := our_cb^.LASTCB;
  1306.         whipFromList (root_cb, our_cb);
  1307.         our_cb^.MAGIC := 0;
  1308.         DEALLOCATE (our_cb, SIZE (our_cb^));
  1309.         our_cb := oldc; (* our_cb should point to the cb of the calling module*)
  1310.         DEC (noInits);
  1311.         handle := NIL;
  1312.         
  1313.       END;
  1314.       
  1315.     ELSE                  (* 'handle' is not valid *)
  1316.       gemErrorOccured
  1317.     END;
  1318.     
  1319.     (*  'our_cb' mustn't be 'NIL', if there is any 'cb' left.
  1320.      *)
  1321.     IF our_cb = NIL THEN our_cb := root_cb END;
  1322.     
  1323.     (*  Gib public arrays frei, falls letzter cb abgemeldet wurde.
  1324.      *)
  1325.     IF root_cb = NIL THEN DEALLOCATE (pubs, SIZE (pubs^)) END;
  1326.     
  1327. (*$? TestVersion:
  1328.   WriteString ("leave 'ExitGem'."); WriteLn;
  1329.  *)
  1330.   END exitGem;
  1331.  
  1332. PROCEDURE ExitGem (VAR handle: GemHandle);
  1333.  
  1334.   BEGIN
  1335.     testErrorCheck;
  1336.     exitGem (handle, TRUE);
  1337.   END ExitGem;
  1338.   
  1339. PROCEDURE CurrGemHandle (): GemHandle;
  1340.  
  1341.   (*$L-*)
  1342.   BEGIN
  1343.     ASSEMBLER
  1344.         MOVE.L  our_cb,(A3)+    ; RETURN our_cb
  1345.     END;
  1346.   END CurrGemHandle;
  1347.   (*$L=*)
  1348.  
  1349. PROCEDURE SetCurrGemHandle (handle:GemHandle; VAR success:BOOLEAN);
  1350.          
  1351.   (*$L-*)
  1352.   BEGIN
  1353.     ASSEMBLER
  1354.         MOVE.L  -(A3),-(A7)
  1355.         MOVE.L  -4(A3),-(A7)
  1356.         JSR     isValidGemHandle
  1357.         MOVE.L  (A7)+,A0        ; 'handle' -> A0
  1358.         MOVE.L  (A7)+,A1        ; ADR (success) -> A1
  1359.         MOVE.W  -(A3),(A1)
  1360.         BEQ     noValidHandle
  1361.         
  1362.         MOVE.L  A0,our_cb       ; is valid => set handle
  1363.         
  1364. noValidHandle
  1365.     END;
  1366.   END SetCurrGemHandle;
  1367.   (*$L=*)
  1368.  
  1369.  
  1370.                 (* Die File-Selektor-Box-Option *)
  1371.                 
  1372. (*
  1373. VAR     selector        : FileSelectProc;
  1374.          
  1375. PROCEDURE SetSelector (fsel: FileSelectProc);
  1376.  
  1377.   (*$L-*)
  1378.   BEGIN
  1379.     ASSEMBLER
  1380.         JSR     testErrorCheck
  1381.         MOVE.L  -(A3),selector
  1382.     END;
  1383.   END SetSelector;
  1384.   (*$L=*)
  1385.  
  1386. PROCEDURE RemoveSelector;
  1387.  
  1388.   (*$L-*)
  1389.   BEGIN
  1390.     ASSEMBLER
  1391.         JSR     testErrorCheck
  1392.         MOVE.L  our_cb,A0
  1393.         MOVE.L  cb.FSEL(A0),selector
  1394.     END;
  1395.   END RemoveSelector;
  1396.   (*$L=*)
  1397.  
  1398. PROCEDURE SelectFile (REF label     : ARRAY OF CHAR;
  1399.                       VAR path, name: ARRAY OF CHAR;
  1400.                       VAR ok        : BOOLEAN);
  1401.  
  1402.   (*$L-*)
  1403.   BEGIN
  1404.     ASSEMBLER
  1405.         JSR     testErrorCheck
  1406.         MOVE.W  #TRUE,(A3)+
  1407.         JSR     mouseInput
  1408.         
  1409.         MOVE.L  selector,A1
  1410.         JSR     (A1)
  1411.   
  1412.         MOVE.W  #FALSE,(A3)+
  1413.         JSR     mouseInput
  1414.     END;
  1415.   END SelectFile;
  1416.   (*$L=*)
  1417.  
  1418. PROCEDURE saveSelector;
  1419.  
  1420.   (*$L-*)
  1421.   BEGIN
  1422.     ASSEMBLER
  1423.         MOVE.L  our_cb,A0
  1424.         MOVE.L  selector,cb.FSEL(A0)
  1425.     END;
  1426.   END saveSelector;
  1427.   (*$L=*)
  1428.  *)
  1429.   
  1430. PROCEDURE selectFileTOSDependent (REF label     : ARRAY OF CHAR;
  1431.                                   VAR path, name: ARRAY OF CHAR;
  1432.                                   VAR ok        : BOOLEAN);
  1433.  
  1434.   (*$L-*)
  1435.   BEGIN
  1436.     ASSEMBLER
  1437.         JSR     testErrorCheck
  1438.         MOVE.W  #TRUE,(A3)+
  1439.         JSR     mouseInput
  1440.         
  1441.         JSR     GEMVersion
  1442.         MOVE.W  -(A3),D0
  1443.         CMP.W   #$0300,D0
  1444.         BCC     newTOS                  ; GEM 3.0 kann fsel_exinput
  1445.         CMP.W   #$0200,D0
  1446.         BCC     oldTOS                  ; GEM 2.0 kann fsel_exinput nicht
  1447.         CMP.W   #$0140,D0
  1448.         BCS     oldTOS                  ; erst 1.4 kann fsel_exinput
  1449.  
  1450. newTOS  JSR     selectFileExtended
  1451.         MOVE.W  #FALSE,(A3)+
  1452.         JMP     mouseInput
  1453.  
  1454. oldTOS
  1455.         JSR     selectFile
  1456.         SUBQ.L  #6,A3
  1457.         MOVE.W  #FALSE,(A3)+
  1458.         JMP     mouseInput
  1459.     END;
  1460.   END selectFileTOSDependent;
  1461.   (*$L=*)
  1462.   
  1463.  
  1464.                         (*  Nachfragefunktionen  *)
  1465.                         (*  ===================  *)
  1466.  
  1467. PROCEDURE GEMAvailable (): BOOLEAN;
  1468.   VAR   success: BOOLEAN;
  1469.   BEGIN
  1470.     IF gemStatus = unkown THEN
  1471.       (*  Als Seiteneffekt setzt 'InitGem' die Var. 'gemStatus': *)
  1472.       InitApplication (success);
  1473.       IF success THEN
  1474.         ExitApplication
  1475.       END;
  1476.     END;
  1477.     RETURN gemStatus = available
  1478.   END GEMAvailable;
  1479.   
  1480. PROCEDURE GDOSAvailable (): BOOLEAN;
  1481.   (* Liefert bei GEM 2.1 immer TRUE *)
  1482.   (*$L-*)
  1483.   BEGIN
  1484.     ASSEMBLER
  1485.         MOVEQ   #TRUE,D0
  1486.         MOVE.L  our_cb,A0
  1487.         CMPI.W  #$0210,cb.GLOBAL.ap_version(A0)
  1488.         BEQ     rtn
  1489.       vq_gdos
  1490.         MOVEQ   #-2,D0
  1491.         TRAP    #2
  1492.         ADDQ.W  #2,D0
  1493.         SNE     D0
  1494.         ANDI    #1,D0
  1495.       rtn
  1496.         MOVE    D0,(A3)+
  1497.     END;
  1498.   END GDOSAvailable;
  1499.   (*$L=*)
  1500.   
  1501. PROCEDURE ApplicationID (): CARDINAL;
  1502.  
  1503.   (*$L-*)
  1504.   BEGIN
  1505.     ASSEMBLER
  1506.         MOVE.L  our_cb,A0
  1507.         MOVE.W  cb.GLOBAL.ap_id(A0),(A3)+
  1508.     END;
  1509.   END ApplicationID;
  1510.   (*$L=*)
  1511.  
  1512. PROCEDURE GEMVersion (): CARDINAL;
  1513.  
  1514.   (*$L-*)
  1515.   BEGIN
  1516.     ASSEMBLER
  1517.         MOVE.L  our_cb, D0
  1518.         BEQ     err
  1519.         MOVE.L  D0, A0
  1520.         MOVE.W  cb.GLOBAL.ap_version(A0), (A3)+
  1521.         BRA     ende
  1522. err
  1523.         TRAP    #noErrorTrap
  1524.         DC.W    GeneralErr - $E000
  1525.         ACZ     'GEM NOT INIT.'
  1526.         SYNC
  1527.         CLR.W   (A3)+
  1528. ende
  1529.     END;
  1530.   END GEMVersion;
  1531.   (*$L=*)
  1532.   
  1533. PROCEDURE MaxPoints():CARDINAL;
  1534.  
  1535.   (*$L-*)
  1536.   BEGIN
  1537.     ASSEMBLER
  1538.         MOVE.W  #ptsinMax,D0
  1539.         ADDQ.W  #1,D0
  1540.         LSR.W   #1,D0
  1541.         MOVE.W  D0,(A3)+        ; liefere (ptsinMax+1)DIV 2
  1542.     END;
  1543.   END MaxPoints;
  1544.   (*$L=*)
  1545.  
  1546. PROCEDURE NoHideCursor (dev:DeviceHandle) :CARDINAL;
  1547.  
  1548.   (*$L-*)
  1549.   BEGIN
  1550.     ASSEMBLER
  1551.         JSR     testErrorCheck
  1552.         
  1553.         SUBQ.W  #2,A7
  1554.         MOVE.L  A7,(A3)+
  1555.         JSR     setDevice
  1556.         TST.W   (A7)+
  1557.         BNE     deviceOk
  1558.         CLR.W   (A3)+
  1559.         BRA     ende
  1560.         
  1561. deviceOk
  1562.         MOVE.L  our_cb,A0
  1563.         MOVE.L  cb.CURDEVICE(A0),A0
  1564.         MOVE.W  device.noHdCurs(A0),(A3)+
  1565. ende
  1566.     END;
  1567.   END NoHideCursor;
  1568.   (*$L=*)
  1569.  
  1570. PROCEDURE NoGrafMouseOff () :CARDINAL;
  1571.  
  1572.   (*$L-*)
  1573.   BEGIN
  1574.     ASSEMBLER
  1575.         JSR     testErrorCheck
  1576.         MOVE.L  our_cb,A0
  1577.         MOVE.W  cb.SUPERVISION.noGrafMouse(A0),(A3)+
  1578.     END;
  1579.   END NoGrafMouseOff;
  1580.   (*$L=*)
  1581.   
  1582. PROCEDURE NoUpdateWindow():CARDINAL;
  1583.  
  1584.   (*$L-*)
  1585.   BEGIN
  1586.     ASSEMBLER
  1587.         JSR     testErrorCheck
  1588.         MOVE.L  our_cb,A0
  1589.         MOVE.W  cb.SUPERVISION.noUpWind(A0),(A3)+
  1590.     END;
  1591.   END NoUpdateWindow;
  1592.   (*$L=*)
  1593.  
  1594. PROCEDURE NoMouseControl():CARDINAL;
  1595.  
  1596.   (*$L-*)
  1597.   BEGIN
  1598.     ASSEMBLER
  1599.         JSR     testErrorCheck
  1600.         MOVE.L  our_cb,A0
  1601.         MOVE.W  cb.SUPERVISION.noMouseCtrl(A0),(A3)+
  1602.     END;
  1603.   END NoMouseControl;
  1604.   (*$L=*)
  1605.  
  1606. PROCEDURE MouseInput (start:BOOLEAN);
  1607.  
  1608.   (*$L-*)
  1609.   BEGIN
  1610.     ASSEMBLER
  1611.         JMP     mouseInput
  1612.     END;
  1613.   END MouseInput;
  1614.   (*$L=*)
  1615.  
  1616.  
  1617.                         (*  Misc. managment  *)
  1618.                         (*  ===============  *)
  1619.  
  1620. VAR fathersSelectFile: PathEnv.FileSelectProc;
  1621.     gotFather: BOOLEAN;
  1622.  
  1623. PROCEDURE envelopeProc (start, child: BOOLEAN; VAR id: INTEGER);
  1624.  
  1625.   VAR     ptr     : p_cb;
  1626.           again   : BOOLEAN;
  1627.  
  1628.   BEGIN
  1629.     IF NOT child THEN
  1630.       IF start THEN
  1631.         gotFather:= FALSE;
  1632.         IF GemActive () THEN
  1633.           fathersSelectFile:= PathEnv.SelectFile;
  1634.           gotFather:= TRUE
  1635.         END
  1636.       END
  1637.     ELSE
  1638.       IF start THEN
  1639.         INC (modID);
  1640.         appIsInit[modID]:= FALSE;
  1641.         didShRead[modID]:= FALSE;
  1642.         (*
  1643.          * Damit ein Prg "EasyGEM1.SelectFile" benutzen kann, ohne selbst
  1644.          * ein GemInit machen zu müssen, muß hier die Routine neu zuge-
  1645.          * wiesen werden, da EasyGEM1 nur dann selbst ein GemInit macht,
  1646.          * wenn GemActive () FALSE liefert.
  1647.          *)
  1648.         IF gotFather THEN PathEnv.SelectFile:= fathersSelectFile END;
  1649.       ELSE
  1650.       
  1651. (*$? TestVersion:
  1652.   WriteString ("'GEMEnv': Killing level "); WriteString (CardToStr (modID, 0));
  1653.   WriteString (' [');
  1654.  *)
  1655.         ptr := root_cb;
  1656.         LOOP
  1657.  
  1658.           IF ptr = NIL THEN EXIT
  1659.           ELSIF ptr^.OWNER_ID = modID THEN
  1660. (*$? TestVersion:
  1661.   WriteString (' ID: '); WriteString (CardToStr (ptr^.OWNER_ID, 0));
  1662.  *)
  1663.             exitGem (ptr, TRUE);
  1664.             ptr := root_cb;
  1665.           ELSIF ptr^.OWNER_ID = - modID THEN
  1666. (*$? TestVersion:
  1667.   WriteString (' ID: '); WriteString (CardToStr (ptr^.OWNER_ID, 0));
  1668.  *)
  1669.             exitGem (ptr, FALSE);
  1670.             ptr^.OWNER_ID := 0;
  1671.             ptr := root_cb;
  1672.           ELSE ptr := ptr^.LASTCB END;
  1673.           error:= FALSE
  1674.           
  1675.         END;
  1676. (*$? TestVersion:
  1677.   WriteString (']'); WriteLn;
  1678.  *)
  1679.         
  1680.         DEC (modID);
  1681.         
  1682.       END;
  1683.       
  1684.     END;
  1685.   END envelopeProc;
  1686.  
  1687. PROCEDURE termProc;
  1688.  
  1689.   BEGIN
  1690.   
  1691. (*$? TestVersion:
  1692.   WriteString ("'GEMEnv' terminating (Level: ");
  1693.   WriteString (CardToStr (modID, 0)); WriteString (")..."); WriteLn;
  1694.  *)
  1695.  
  1696.     (*  Current 'modID = 2'. That means all init.s but the SysInit.s are
  1697.      *  released.
  1698.      *  Decrements 'modID' to '1', to release the SysInit.s at the call
  1699.      *  of 'removalProc'.
  1700.      *)
  1701.     envelopeProc (FALSE, TRUE, voidI);
  1702.     
  1703. (*$? TestVersion:
  1704.   WriteString ("...'GEMEnv' terminated."); WriteLn;
  1705.  *)
  1706.  
  1707.   END termProc;
  1708.  
  1709. PROCEDURE removalProc;
  1710.   
  1711.   BEGIN
  1712.   
  1713. (*$? TestVersion:
  1714.   WriteString ("'GEMEnv' removing (Level: ");
  1715.   WriteString (CardToStr (modID, 0)); WriteString ("..."); WriteLn;
  1716.  *)
  1717.  
  1718.     (*  Current 'modID = 1'. That means all init.s are released.
  1719.      *  Decrements 'modID' to '0'.
  1720.      *)
  1721.     envelopeProc (FALSE, TRUE, voidI);
  1722.     
  1723. (*$? TestVersion:
  1724.   WriteString ("...'GEMEnv' removed."); WriteLn;
  1725.  *)
  1726.  
  1727.   END removalProc;
  1728.  
  1729.  
  1730. (* nicht mehr benutzt:
  1731.   (*$L-*)
  1732.   PROCEDURE GemErrorHandler;
  1733.     BEGIN
  1734.       ASSEMBLER
  1735.           TRAP    #noErrorTrap
  1736.           DC.W    GemErr
  1737.       END
  1738.     END GemErrorHandler;
  1739.   (*$L=*)
  1740. *)
  1741.  
  1742. (*$L-*)
  1743. PROCEDURE emptyProc;
  1744.   END emptyProc;
  1745. (*$L=*)
  1746.  
  1747. VAR     wsp             : MemArea;
  1748.         envlpHandle     : EnvlpCarrier;
  1749.         termHandle      : TermCarrier;
  1750.         removalHandle   : RemovalCarrier;
  1751.  
  1752. BEGIN
  1753.  
  1754.  (*
  1755.   (*  Erste Selektor-Box ist die GEM-Box
  1756.    *)
  1757.   selector := selectFileTOSDependent;
  1758.   *)
  1759.   
  1760.   (*  Anmeldung der Modulüberwachung
  1761.    *)
  1762.   noInits := 0;
  1763.   modID := 2;                     (* Zähle Module levels *)
  1764.   SetEnvelope (envlpHandle, envelopeProc, wsp);
  1765.   CatchProcessTerm (termHandle, termProc, wsp);
  1766.   CatchRemoval (removalHandle, removalProc, wsp);
  1767.   
  1768.   ErrorProc := emptyProc; (* ehemals: GemErrorHandler; *)
  1769.   errorProcPtr := ADR (ErrorProc);
  1770.   ErrHdlProc:= emptyProc;
  1771.   ptrToErrHdler := ADR (ErrHdlProc);
  1772.   
  1773.   gemStatus := unkown;
  1774.   
  1775. END GEMEnv.
  1776.  
  1777.